home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / bbs_util / dctta005.zip / TAGSRC05.ZIP / DCTTAG.PAS < prev    next >
Pascal/Delphi Source File  |  1996-06-11  |  5KB  |  155 lines
  1. {  DCTTag v0.05  -  DctTag.Pas  -  June 11, 1996.                 }
  2. {  Copyright 1995, 1996 by Dan Traczynski.  All rights reserved.  }
  3.  
  4. {    This door will select ten random taglines from a tagline file and      }
  5. { prompt the user on which one to append to his message.  He can also add   }
  6. { his own tagline, or abort without any changes to his message.  The door   }
  7. { will work with any BBS program that uses the MSGTMP file format (RA,      }
  8. { SuperBBS, Concord[?], etc.).                                              }
  9. {                                                                           }
  10. {    The code compiles under Turbo Pascal 7.0 and some units do not include }
  11. { the source (such as DDPlus.Tpu).  The reason for this is that I am unsure }
  12. { of the copyrights on the door driver I used, so rather than distributing  }
  13. { the modified source code, I am simply going to include the compiled units }
  14. { along with it.                                                            }
  15. {                                                                           }
  16. {    You may do what you like with this code, but if you make any changes   }
  17. { to the program, you cannot distribute the modified code or compiled       }
  18. { executable to anyone without my prior consent.                            }
  19. {                                                                           }
  20. { And now for the disclaimer...                                             }
  21. {                                                                           }
  22. {    The author, Daniel Traczynski, will take no responsibility to anything }
  23. { that this program may or may not do to your system.  Although the program }
  24. { has been tested thoroughly, no guarantee can be given that it will do     }
  25. { what it was made to do.  Nevertheless, if anything should happen, the     }
  26. { user is totally responsible and the author will be under no obligations   }
  27. { whatsoever.  By using this program and/or source code, you agree to this  }
  28. { disclaimer.                                                               }
  29.  
  30. Program DCTTag;
  31.  
  32. {$R-}{$S+}{$I+}{$N-}{$M 65520,16384,16384}
  33.  
  34. Uses Crt, DDPlus, TagUnit;
  35.  
  36. Var Y      : Word;
  37.     Z      : Integer;
  38.     TMP    : String;
  39.     Good,
  40.     ReDisp : Boolean;
  41.     Cur    : Byte;
  42.  
  43. Procedure Init;
  44. Begin
  45.  If Not FileExists('MSGTMP') Then Begin
  46.   WriteLn('MSGTMP not found, program aborted.');
  47.   Halt;
  48.  End;
  49.  InitDoorDriver;
  50.  If Graphics > 2 Then AnsiOn := True;
  51.  Header;
  52.  TagsAvail := 0;
  53.  GetTags;
  54. End;
  55.  
  56. Procedure Disp;
  57. Begin
  58.   X := WhereX;
  59.   SGoto_XY(4, 6 + Cur);
  60.   Set_Foreground(15);
  61.   Set_Background(6);
  62.   SWrite(' ' + Tag[Cur]);
  63.   SClrEol;
  64.   SGoto_XY(31, 21);
  65.   Set_Background(0);
  66. End;
  67.  
  68. Procedure Clear;
  69. Begin
  70.   X := WhereX;
  71.   SGoto_XY(4, 6 + Cur);
  72.   WriteKewl(' ' + Tag[Cur]);
  73.   SClrEol;
  74. End;
  75.  
  76. Begin
  77.  Init;
  78.  SWriteLn('D███████████'#13#10);
  79.  Good := False;
  80.  ReDisp := True;
  81.  Cur := 1;
  82.  Repeat
  83.   If ReDisp Then DisplayTags;
  84.   ReDisp := True;
  85.   Disp;
  86.   Repeat
  87.     SRead_Char(Ch);
  88.     Ch := UpCase(Ch);
  89.     If Ch = #3 Then Begin { Just broke out of chat so redraw bottom of screen }
  90.       SGoto_XY(1, 18);
  91.       If Not NoDefined Then SWriteLn('▌R▐ Select a random tagline from the ten above.');
  92.       SWriteLn('▌S▐ Search for more taglines.');
  93.       SWriteLn('');
  94.       TimeWarn;
  95.       SWrite('Your Choice (ESC=No Tagline)? ');
  96.       Current_Foreground := 7;
  97.     End;
  98.   Until Ch In ['0'..'9', #27, 'A', 'R', 'S', ^E, ^S, ^X, ^D, #13];
  99.   Case Ch Of
  100.     ^E, ^S: Begin
  101.               Clear;
  102.               If Cur = 1 Then Cur := 10 Else Dec(Cur);
  103.               ReDisp := False;
  104.             End;
  105.     ^D, ^X: Begin
  106.               Clear;
  107.               If Cur = 10 Then Cur := 1 Else Inc(Cur);
  108.               ReDisp := False;
  109.             End;
  110.     'R': Begin
  111.            SWriteLn('Random');
  112.            WriteTag(Tag[Random(10) + 1], 0);
  113.            Good := True;
  114.          End;
  115.     'S': Begin
  116.            ClearTagList;
  117.            SGoto_XY(2, 5);
  118.            SWrite('░░░░░░░░░░░D');
  119.            GetTags;
  120.            SWriteLn('D███████████'#13#10);
  121.          End;
  122.     #27: Begin
  123.            SWriteLn('Abort'#13#10);
  124.            SWriteLn('Saving Message Without Tagline...');
  125.            Current_Foreground := 8;
  126.          End;
  127.     'A': If Not NoDefined Then Begin
  128.            CustomTag(TMP);
  129.            If (TMP <> '') Then Good := True;
  130.          End;
  131.     #13: Begin
  132.            Str(Cur, Tmp);
  133.            SWriteLn(Tmp);
  134.            WriteTag(Tag[Cur], 0);
  135.            Good := True;
  136.          End;
  137.     '0'..'9':
  138.          Begin
  139.            SWriteLn(Ch);
  140.            Val(Ch, X, Z);
  141.            If X = 0 Then X := 10;
  142.            WriteTag(Tag[X], 0);
  143.            Good := True;
  144.          End;
  145.     Else ReDisp := False;
  146.   End;
  147.  Until (Good) Or (Ch = #27);
  148.  X := WhereX;
  149.  Y := WhereY;
  150.  Window(1, 1, 80, NumLines);
  151.  TextBackground(0);
  152.  GotoXY(1, NumLines);
  153.  ClrEol;
  154.  GotoXY(X, Y);
  155. End.